home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / basic / bitstuf.com / FARBIT2.ASM < prev    next >
Encoding:
Assembly Source File  |  1990-07-28  |  4.4 KB  |  150 lines
  1.     page 66, 132
  2.     title Binary (bit) oriented STR and VAL for BASIC7 / QBX
  3.     subttl By Jim Mack, Editing Services Co.
  4.  
  5. odg    equ    <offset dgroup>
  6.  
  7. comment |
  8.  
  9.     Updated 7/28/90 for BC7 and QBX
  10. ==============================================================================
  11.         THIS VERSION IS ONLY FOR BC7.x AND QBX
  12. ==============================================================================
  13.  
  14.     Implements routines to generate and interpret binary strings.
  15.  
  16.     Two procedures are declared in BASIC:
  17.  
  18.     DECLARE FUNCTION BitStr$ (word%)
  19.     DECLARE FUNCTION BitVal& (ones$)  'or BitVal% (ones$)
  20.  
  21.     BitStr returns a 16-byte string in the form "0010010000111001"
  22.      with 1's corresponding to set bits in WORD%
  23.  
  24.     BitVal returns the value of a string such as the one above.  Only the
  25.      first 16 places in the string are evaluated.  Fewer may be used.
  26.      A null string returns a zero result.
  27.  
  28.     NOTE: BitVal can be declared as an integer function instead, since
  29.     the entire value is returned in the lower 16 bits.  If you use it
  30.     that way, returned vales are signed integers: a string whose highest
  31.     bit is set will return a negative value.  As a long integer function,
  32.     values are always positive.
  33.  
  34.     | comment ends
  35.  
  36.                                     page+
  37. EXTRN    StringAssign:FAR        ; in the BC/QBX runtime
  38. EXTRN    StringAddress:FAR
  39. EXTRN    StringLength:FAR
  40.  
  41.     .model medium, basic
  42.                                     page+
  43.     .data
  44.  
  45. ; This is a string descriptor and associated string body for our use
  46.  
  47. StrDesc        dd    0        ; this is a valid QBX string descriptor...
  48.  
  49. StrText        db    16 dup (0)    ; our local string
  50.  
  51.     .code
  52.  
  53. BitStr        PROC uses di, vlu
  54.  
  55.     cld
  56.     mov    ax, ds
  57.     mov    es, ax            ; this so "stosb" will work for sure
  58.     assume    es:@data
  59.     mov    bx, vlu
  60.     mov    dx, [bx]        ; dx = word containing bits to test
  61.     mov    cx, 16            ; number of bit positions
  62.     mov    di, odg:StrText        ; point to beginning of our own string
  63.     mov    ah, '0'
  64. @@:    mov    al, ah            ; for each bit, start with "0"
  65.     shl    dx, 1            ; shift a bit into carry
  66.     adc    al, 0            ; makes "0" into "1" if bit is set
  67.     stosb                ; put "0" or "1" into string
  68.     loop    @b            ; until all 16 bits tested
  69.     push    ds            ; push segment and offset to...
  70.     mov    ax, odg:StrText        ; ...our string text
  71.     push    ax
  72.     mov    ax, 16
  73.     push    ax            ; indicate length of our string
  74.     push    ds            
  75.     mov    ax, odg:StrDesc
  76.     push    ax            ; pass seg+ofs of our descriptor
  77.     xor    ax, ax
  78.     push    ax            ; pass a zero to indicate VL string
  79.     call    StringAssign        ; move our string into BASIC's
  80.     mov    ax, odg:StrDesc        ; pointer to our own descriptor
  81.     ret
  82.  
  83. BitStr        ENDP
  84.                                     page+
  85. BitVal        PROC uses di si, str
  86.  
  87. ;  The value is taken in two steps: first, the passed string is right-
  88. ;  justified (RSET) into a local string accumulator of exactly 16 bytes,
  89. ;  with ASCII bias removed.  Then the local string is evaluated to a
  90. ;  numeric result.  This allows strings of fewer than 16 bytes to be
  91. ;  aligned correctly, and illegal values to be detected easily.
  92.  
  93.     cld
  94.     push    str
  95.     call    StringLength        ; get length the BC7 way
  96.     or    ax, ax
  97.     jz    bv99            ; null string passed, exit with zero
  98.     push    ax            ; hold length of source string
  99.     mov    ax, ds
  100.     mov    es, ax            ; point ES to DGROUP
  101.     mov    di, odg:StrText        ; will end up pointing off the end
  102.     mov    cx, 8
  103.     xor    ax, ax
  104.     rep    stosw            ; zero our string accumulator
  105.     push    str
  106.     call    StringAddress        ; get segmented address the BC7 way
  107.     mov    si, ax            ; far address comes back in DX:AX
  108.     mov    ds, dx            ; address of source now in DS:SI
  109.     assume    ds:nothing
  110.     pop    cx            ; recover saved length
  111.     cmp    cx, 16            ; if < 16, use passed length
  112.     jna    @f
  113.     mov    cx, 16            ; maximum string is 16 characters
  114. @@:    add    si, cx
  115.     std                ; work backwards...
  116.     dec    si            ; ...from ends of strings...
  117.     dec    di            ; ...to right-align the data
  118.     xor    bx, bx            ; clear numeric accumulator
  119. @@:    lodsb                ; get string byte
  120.     cmp    al, '1'            ; abort on illegal characters
  121.     ja    bv90
  122.     cmp    al, '0'
  123.     jb    bv90
  124.     and    al, 1            ; remove ASCII bias
  125.     stosb                ; put into string accumulator
  126.     loop    @b
  127.     cld                ; string accumulator now full
  128.     mov    ax, @data
  129.     mov    ds, ax            ; reset DS to DGROUP
  130.     assume    ds:@data
  131.     mov    si, odg:StrText        ; point DS:SI to our string accum.
  132.     mov    cx, 16
  133. @@:                    ; turn string into numeric equivalent
  134.     lodsb
  135.     xor    ah, ah            ; clear AH and clear carry
  136.     sub    ah, al            ; set carry for rotate if '1'
  137.     rcl    bx, 1            ; set bit in result
  138.     loop    @b            ; repeat until string empty
  139. bv90:
  140.     mov    ax, bx            ; accumulator to result
  141. bv99:
  142.     xor    dx, dx            ; make valid for INT or LONG
  143.     cld                ; clean up flags or die later
  144.     ret
  145.  
  146. BitVal        ENDP
  147.  
  148.     END
  149.  
  150.